{
  Author : schiva@empal.com
  Date   : 2011-11-14
  Comment:
}

unit ServerInformation;

interface

uses
  Classes, sysutils, Windows, PacketData, QSocketServer, siAuto,
  DB, kbmMemBinaryStreamFormat, kbmMemTable, kbmMemTableUtils;

Type
  TOnUpdateData = procedure(Sender: TObject; var cmd:integer;  var Values:TStringList) of Object;
  TServerInformation = Class(TComponent)
    private
      FPacketData: TPacketData;
      FStream: TMemoryStream;
      FData: TStringList;
      FThread: TThread;

      FTCP: TQSocketServer;
      FActive: Boolean;
      FInterval: integer;
      FOnUpdateData: TOnUpdateData;

      procedure SetTCP(const Value: TQSocketServer);
      procedure SetActive(const Value: Boolean);
      procedure OnThreadTerminate(Sender:TObject);
      procedure Event_UpdateData;

      procedure Do_StartThread;
      procedure Do_StopThread;
    protected
      FTBL: TkbmMemTable;
      procedure Do_BuildTable; virtual;
    public
      property TCP: TQSocketServer read FTCP Write SetTCP;
      Constructor Create(AOwner:TComponent); override;
      Destructor  Destroy; override;
    published
      property Interval: integer read FInterval Write FInterval;
      property Active: Boolean read FActive Write SetActive;
      property OnUpdateData: TOnUpdateData read FOnUpdateData Write FOnUpdateData;
  End;


implementation

Type
  TRunner = Class(TThread)
    private
      FSP: Cardinal;
      FOwner: TServerInformation;
      procedure Do_Process;
    protected
      procedure Execute; override;
    public
      WaitHandle:THandle;
      Constructor Create(AOwner:TServerInformation); reintroduce; overload;
      Destructor  Destroy; override;
  End;

{ TServerInformation }

constructor TServerInformation.Create(AOwner: TComponent);
begin
  inherited;
  FTBL := kbmMemTableUtils.KBMMemoryTableCreate(self);
  Do_BuildTable;
  FInterval := 1000;
  FData := TStringList.Create;
  FData.LineBreak := '<LB>';
  FTCp := nil;

  FPacketData := TPacketData.Create;
  FStream     := TMemoryStream.Create;
  FActive     := False;
end;

destructor TServerInformation.Destroy;
begin
  FreeAndNil( Ftbl );
  FreeAndNil( FData );
  FreeAndNil( FPacketData );
  FreeAndNil( FStream );
  inherited;
end;

procedure TServerInformation.Do_BuildTable;
begin
  with FTBL.FieldDefs do
  begin
    Add('Status', ftinteger);
    Add('CPU', ftFloat );
    Add('RAM', ftInteger );
  end;
  FTBL.Open;
end;

procedure TServerInformation.Do_StartThread;
begin
  if Assigned(FThread) then Exit;
  FThread := TRunner.Create(self);
  FThread.OnTerminate := OnThreadTerminate;
  Fthread.FreeOnTerminate := True;
  FThread.Resume;
end;

procedure TServerInformation.Do_StopThread;
begin
  if not Assigned(FThread) then Exit;
  FThread.OnTerminate := nil;
  FThread.Terminate;
  WaitForSingleObject(TRunner(Fthread).WaitHandle, 1000);
  FThread := nil;
end;

procedure TServerInformation.Event_UpdateData;
var
  I, CMD: Integer;
  fldName: string;
  fldValue: string;
begin
  if not Assigned(FTCP) then Exit;
  if not FTCP.Active then Exit;

  
  FTBL.EmptyTable;

  FData.Clear;
  if Assigned(FOnUpdateData) then
  begin
    FOnUpdateData(Self, CMD, FData);

    FTBL.Append;
    Ftbl.Edit;
    for I := 0 to FData.Count - 1 do
    begin
      fldName := FData.Names[i];
      fldValue:= FData.Values[fldName];

      if FTBL.FieldList.IndexOf(fldName) = -1 then continue;
      try
        FTBL.FieldByName(fldName).Value := fldValue;
      Except
      end;
    end;
    FTBL.Post;
  end;

  if Ftbl.IsEmpty then Exit;

  FStream.Clear;
  FTbl.SaveToStream( FStream );
  FStream.Position := 0;

  FPacketData.Add( CMD, FStream.Memory, FStream.Size );
  FTCp.BroadCast(FPacketData.Data,  FPacketData.Size  );
end;


procedure TServerInformation.OnThreadTerminate(Sender: TObject);
begin
  FThread := nil;
end;

procedure TServerInformation.SetActive(const Value: Boolean);
begin
  if FActive = Value then Exit;

  FActive := Value;

  if FActive then Do_StartThread
  else Do_StopThread;
  
end;

procedure TServerInformation.SetTCP(const Value: TQSocketServer);
begin
  FTCP := Value;
end;

{ TRunner }

constructor TRunner.Create(AOwner: TServerInformation);
begin
  inherited Create(True);
  FOwner := AOwner;
  WaitHandle := CreateEvent(nil, False, False, '');
end;

destructor TRunner.Destroy;
begin
  CloseHandle(WaitHandle);
  inherited;
end;

procedure TRunner.Do_Process;
begin
  if GetTickCount - FSP < FOwner.FInterval then Exit;

  FSP := GetTickCount;
  FOwner.Event_UpdateData;
end;

procedure TRunner.Execute;
begin
  Try
    while not Terminated do
    begin
      try
        Do_Process;

      Except on e:Exception do
        siMain.LogException(e, self.ClassName);
      end;
      WaitForSingleObject(self.Handle, 2);
    end;
  Finally
    SetEvent(WaitHandle);
  End;

end;

end.
